home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / os2 / octa209s.zip / octave-2.09 / libcruft / blas / dasum.f next >
Text File  |  1997-01-29  |  1KB  |  44 lines
  1.       double precision function dasum(n,dx,incx)
  2. c
  3. c     takes the sum of the absolute values.
  4. c     jack dongarra, linpack, 3/11/78.
  5. c     modified 3/93 to return if incx .le. 0.
  6. c     modified 12/3/93, array(1) declarations changed to array(*)
  7. c
  8.       double precision dx(*),dtemp
  9.       integer i,incx,m,mp1,n,nincx
  10. c
  11.       dasum = 0.0d0
  12.       dtemp = 0.0d0
  13.       if( n.le.0 .or. incx.le.0 )return
  14.       if(incx.eq.1)go to 20
  15. c
  16. c        code for increment not equal to 1
  17. c
  18.       nincx = n*incx
  19.       do 10 i = 1,nincx,incx
  20.         dtemp = dtemp + dabs(dx(i))
  21.    10 continue
  22.       dasum = dtemp
  23.       return
  24. c
  25. c        code for increment equal to 1
  26. c
  27. c
  28. c        clean-up loop
  29. c
  30.    20 m = mod(n,6)
  31.       if( m .eq. 0 ) go to 40
  32.       do 30 i = 1,m
  33.         dtemp = dtemp + dabs(dx(i))
  34.    30 continue
  35.       if( n .lt. 6 ) go to 60
  36.    40 mp1 = m + 1
  37.       do 50 i = mp1,n,6
  38.         dtemp = dtemp + dabs(dx(i)) + dabs(dx(i + 1)) + dabs(dx(i + 2))
  39.      *  + dabs(dx(i + 3)) + dabs(dx(i + 4)) + dabs(dx(i + 5))
  40.    50 continue
  41.    60 dasum = dtemp
  42.       return
  43.       end
  44.